﻿'reference to http://msdn.microsoft.com/en-sg/magazine/cc188929(en-us).aspx#S1
'http://www.thecodinghumanist.com/Content/HowToWriteAWebCrawlerInCSharp.aspx

Option Explicit On

Imports System.Threading
Imports Microsoft.Win32
Imports System.Net
Imports System.IO
Imports System.Data
Imports System.Data.OleDb
Imports System.Data.SqlClient



Public Class iMain

    Dim m_oThread() As Thread         'Dim out the thread object
    Dim m_oThreadPage() As String     'Dim out a page name to keep for the thread
    Dim m_oThreadID() As Integer      'Dim out the thread id of the elements
    Dim m_sNow As String              'Dim out the Start Date of each process

    Public m_sPages() As String          'Dim out the pages array so that we can process these
    Public m_sPagesDone() As String       'Give a listing of what's already been done
    Dim m_bCancelClicked As Boolean       'Tell whether or not the cancel button has been clicked
    Dim m_sFileExtensions() As String

    Dim m_sFileTypes() As String
    Dim m_sSites() As String
    Dim m_sSiteNames() As String
    Dim strConn As String = My.Settings.dbConn.ToString()



    Private Sub iMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        Dim i As Integer

        Application.DoEvents()
        LoadListBox()
        lblWelcome.Text = "welcome " + iLogin.username + "!"

        Me.Opacity = 0
        Me.Show()
        For i = 1 To 100 Step 10
            Me.Opacity = i / 100
            Application.DoEvents()
        Next i
        Me.Opacity = 1

        GetRegistrySettings()

        Me.Show()

    End Sub

    Private Function isValidURL(ByVal strURL As String) As Boolean
        Try
            Dim req As HttpWebRequest = HttpWebRequest.Create(strURL)
            Dim res As HttpWebResponse = req.GetResponse()

            If res.StatusCode.ToString().ToUpper() = "OK" Then
                Return True
            Else
                Return False
            End If
        Catch ex As Exception
            Return False
        End Try
    End Function

    Private Sub LoadListBox()
        Try
            listSite.Items.Clear()
            listSite.BeginUpdate()

            Dim conn1 As New SqlConnection(strConn)
            Dim mySQL1 As String = "GetSite"
            Dim drFileTypes As SqlDataReader
            Dim cmd1 As New SqlCommand(mySQL1, conn1)
            cmd1.CommandType = CommandType.StoredProcedure
            conn1.Open()
            drFileTypes = cmd1.ExecuteReader()

            Do While drFileTypes.Read()
                listSite.Items.Add(New clsboxOverride(drFileTypes.GetString(drFileTypes.GetOrdinal("sSiteName")), _
                                                drFileTypes.GetString(drFileTypes.GetOrdinal("sSiteStartURL")), _
                                                drFileTypes.GetValue(drFileTypes.GetOrdinal("iSiteID"))))
            Loop
            If listSite.Items.Count > 0 Then listSite.SetSelected(0, True)
            drFileTypes.Close()
            listSite.EndUpdate()
        Catch ex As Exception
            MsgBox(ex.Message)
            Debug.WriteLine("loading a listbox: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
            WriteErrorLog("loading a listbox: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
        End Try
    End Sub


    Private Sub btnAddSite_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAddSite.Click

        Dim sitename As String = InputBox("enter a name for the site." & vbLf & vbLf & "(ex: singapore institute of management)", "site name", )
        If sitename.Trim = "" Then Exit Sub

        Dim siteURL As String = InputBox("enter the url for the site." & vbLf & vbLf & "(ex: http://www.sim.edu.sg)", "site url")
        If siteURL.Trim = "" Then Exit Sub

        If isValidURL(siteURL) Then

            Try
                Select Case True
                    Case LCase(Mid(siteURL, siteURL.Length() - 3, 4)) = ".com", _
                            LCase(Mid(siteURL, siteURL.Length() - 3, 4)) = ".net", _
                            LCase(Mid(siteURL, siteURL.Length() - 3, 4)) = ".org", _
                            LCase(Mid(siteURL, siteURL.Length() - 3, 4)) = ".biz", _
                            LCase(Mid(siteURL, siteURL.Length() - 3, 4)) = ".edu", _
                            LCase(Mid(siteURL, siteURL.Length() - 3, 4)) = ".sg", _
                            LCase(Mid(siteURL, siteURL.Length() - 3, 4)) = ".gov", _
                            LCase(Mid(siteURL, siteURL.Length() - 3, 4)) = ".au"
                        siteURL = siteURL & "/"
                End Select
            Catch ex As Exception
                MsgBox("invalid url")
                Exit Sub
            End Try


            Try
                Dim cnn As SqlConnection = New SqlConnection(strConn)
                Dim mySQL As String = "InsertSites"
                Dim cmd As New SqlCommand(mySQL, cnn)
                cmd.CommandType = CommandType.StoredProcedure
                cmd.Parameters.Add(New SqlParameter("@sSiteName", sitename))
                cmd.Parameters.Add(New SqlParameter("@sSiteStartURL", siteURL))

                cnn.Open()
                Dim lRecsAffected As Long = cmd.ExecuteNonQuery()

                If lRecsAffected = 1 Then
                    MsgBox("site already exist.", MsgBoxStyle.OkOnly, "site url exist")
                End If

                cnn.Close()

            Catch ex As Exception
                MsgBox(ex.Message.ToString)
                Debug.WriteLine("Adding new website: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
                WriteErrorLog("Adding new website: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
            Finally
                LoadListBox()
            End Try
        Else
            MsgBox("invalid url. Please ensure url begins with http://", MsgBoxStyle.Exclamation, "site url invalid")
        End If
    End Sub

    Private Sub btnDeleteSite_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDeleteSite.Click
        Try
            If MsgBox("are you sure you want to delete the selected site?", _
                MsgBoxStyle.Question + MsgBoxStyle.YesNo + MsgBoxStyle.DefaultButton2, _
                "delete Sites?") = MsgBoxResult.No Then Exit Sub
            Dim i As Integer = 0

            Do While i < listSite.Items.Count
                If listSite.GetSelected(i) Then
                    Dim conn As New SqlConnection(strConn)
                    Dim mySQL As String = "DeleteSite"
                    Dim cmd As New SqlCommand(mySQL, conn)
                    cmd.CommandType = CommandType.StoredProcedure
                    cmd.Parameters.Add(New SqlParameter("@iSiteID", listSite.Items(i).SiteID.ToString))
                    conn.Open()
                    Dim lRecsAffected As Long = cmd.ExecuteNonQuery()
                    conn.Close()
                End If
                i = i + 1
            Loop

        Catch ex As Exception
            Debug.WriteLine("deleting a website: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
            WriteErrorLog("deleting a website: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
        Finally
            LoadListBox()
        End Try
    End Sub

    Private Sub btnEditSite_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEditSite.Click
        Dim selectedSiteID As Integer
        Dim selectSiteName As String = String.Empty
        Dim selectSiteURL As String = String.Empty
        Dim i As Integer = 0

        Do While i < listSite.Items.Count
            If listSite.GetSelected(i) Then
                selectedSiteID = Convert.ToInt32(listSite.Items(i).SiteID)
                selectSiteName = listSite.Items(i).SiteName.ToString()
                selectSiteURL = listSite.Items(i).SiteURL
                Exit Do
            End If
            i += 1
        Loop

        Dim str As String = InputBox("edit " + selectSiteName + "'s url:", "edit site url", selectSiteURL)

        If str <> String.Empty Then
            If isValidURL(str) Then
                Dim lRecsAffected As Int32 = 0
                Dim conn As New SqlConnection(strConn)
                Dim mySQL As String = "UpdateSites"
                Dim cmd As New SqlCommand(mySQL, conn)
                cmd.CommandType = CommandType.StoredProcedure
                cmd.Parameters.Add(New SqlParameter("@iSiteID", selectedSiteID))
                cmd.Parameters.Add(New SqlParameter("@sSiteStartURL", str))
                conn.Open()
                lRecsAffected = Convert.ToInt32(cmd.ExecuteScalar())
                conn.Close()

                If lRecsAffected = 0 Then
                    MsgBox("url updated.", MsgBoxStyle.OkOnly, "url updated")
                    LoadListBox()
                Else
                    MsgBox("site already exist.", MsgBoxStyle.OkOnly, "site url exist")
                End If
            Else
                MsgBox("invalid url. Please ensure url begins with http://", MsgBoxStyle.Exclamation, "Site URL Invalid")
            End If
        End If
    End Sub

    Private Sub btnProcess_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnProcess.Click
        'start process
        Try
            'disable buttons on start
            btnProcess.Enabled = False
            btnAddSite.Enabled = False
            btnEditSite.Enabled = False
            btnDeleteSite.Enabled = False
            btnCredit.Enabled = False
            btnLogout.Enabled = False
            'txtThreadCount.Enabled = False

            btnCancel.Enabled = True
            'lblProcessed.Visible = True
            'lblRemaining.Visible = True
            lblTimeElapsed.Visible = True

            Me.Refresh()

            'check thread limit
            'If CInt("0" & txtThreadCount.Text) > 5 Then
            'MsgBox("you are limited to 5 concurrent threads while using this process...", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "error...")
            'GoTo Err_ProcessingSpider
            'End If

            'check min thread
            'If CInt("0" & txtThreadCount.Text) <= 0 Then
            'MsgBox("You must have at least 1 thread to run this process.", _
            'MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, _
            '"error...")
            'GoTo Err_ProcessingSpider
            'End If

            'Clear the listboxes
            listProgress.Items.Clear()
            'listStatus.Items.Clear()

            'Enable the timer
            timerMain.Interval = 900
            timerMain.Enabled = True

            'Clear the page and page found array
            ReDim m_sPages(0)
            ReDim m_sPagesDone(0)

            'Reset the cancel clicked var
            m_bCancelClicked = False

            'Process the information
            bProcessSpider()

Err_ProcessingSpider:
            'Turn on the button
            btnProcess.Enabled = True
            btnAddSite.Enabled = True
            btnEditSite.Enabled = True
            btnDeleteSite.Enabled = True
            btnCredit.Enabled = True
            btnLogout.Enabled = True
            btnCancel.Enabled = False
            'txtThreadCount.Enabled = True
            timerMain.Enabled = False
            'lblProcessed.Visible = False
            'lblRemaining.Visible = False
            lblTimeElapsed.Visible = False
            listProgress.Items.Clear()

            'turn off all the progress bars
            Dim cntrl As Control
            For Each cntrl In Me.Controls
                If Mid(LCase(cntrl.Name), 1, 6) = "prgbar" Then cntrl.Visible = False
            Next cntrl
        Catch
            Debug.WriteLine("btnProcess_Click: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
            WriteErrorLog("btnProcess_Click: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
        Finally
            MessageBox.Show("processing completed")
        End Try
    End Sub

    Private Sub btnCancel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCancel.Click
        'kill all process
        Dim i As Integer

        Try
            For i = LBound(m_oThread) To UBound(m_oThread)
                If Not IsNothing(m_oThread(i)) Then
                    If m_oThread(i).IsAlive Then m_oThread(i).Abort()
                End If
            Next i
        Catch ex As Exception
            MsgBox(ex.Message)
            Debug.WriteLine("btnCancel_Click: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
            WriteErrorLog("btnCancel_Click: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
        End Try
    End Sub

    Private Sub btnLogout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLogout.Click
        Try
            If MsgBox("are you sure you want to logout?", _
               MsgBoxStyle.Question + MsgBoxStyle.YesNo + MsgBoxStyle.DefaultButton2, _
               "logout?") = MsgBoxResult.Yes Then

                iLogin.username = ""
                Me.Hide()
                iLogin.Show()


            End If
        Catch ex As Exception
            MessageBox.Show(ex.ToString())
        End Try
    End Sub


    '<start reference: http://msdn.microsoft.com/en-sg/magazine/cc188929(en-us).aspx#S1 >
    Private Sub bProcessSpider()
        Try
            Dim i As Long
            Dim iPagesDone As Integer
            Dim iThreadIndex As Integer
            Dim iThreadCount As Integer
            Dim bOKToExit As Boolean
            Dim sTmpPage As String
            Dim sSiteURL As String = ""
            Dim sSiteName As String = ""

            ReDim m_sSites(0) : ReDim m_sSiteNames(0)

            For i = 0 To listSite.Items.Count - 1
                If listSite.GetSelected(i) Then

                    Debug.WriteLine(listSite.Items(i))
                    sSiteURL = listSite.Items(i).SiteURL.ToString
                    sSiteName = listSite.Items(i).SiteName.ToString

                    If CBool(GetSetting(g_sAppName, "options", "ObeyRobots", False)) Then
                        ProcessRobots(sSiteName, sSiteURL)
                    End If

                    Dim siteName As String = Replace(listSite.Items(i).SiteName.ToString, "'", "''")

                    Dim conn As New SqlConnection(strConn)
                    'Dim mySQL As String = "DeletePagesAndParse"
                    'Dim cmd As New SqlCommand(mySQL, conn)
                    'cmd.CommandType = CommandType.StoredProcedure
                    'cmd.Parameters.Add(New SqlParameter("@SiteName", siteName))
                    'conn.Open()
                    'Dim lRecsAffected As Long = cmd.ExecuteNonQuery()
                    'conn.Close()

                    listSite.SelectedIndex = i

                    m_sNow = Now()

                    'iThreadCount = CLng("0" & txtThreadCount.Text) - 1
                    'If iThreadCount < 0 Then iThreadCount = 1

                    '<start fix thread only>
                    iThreadCount = 4
                    '<end fix thread only>

                    ReDim m_oThread(iThreadCount)
                    ReDim m_oThreadPage(iThreadCount)
                    ReDim m_oThreadID(iThreadCount)

                    StartThreading(sSiteURL, 0, True, sSiteName)

Err_Check_Exit:
                    bOKToExit = True
                    For iThreadIndex = LBound(m_oThread) To UBound(m_oThread)
                        If Not IsNothing(m_oThread(iThreadIndex)) Then
                            If Not m_oThread(iThreadIndex).IsAlive And _
                             m_oThread(iThreadIndex).ThreadState = ThreadState.Stopped Then
                                m_oThread(iThreadIndex).Abort()
                                m_oThread(iThreadIndex) = Nothing

                            End If
                            bOKToExit = False
                        End If
                    Next iThreadIndex
                    If m_bCancelClicked Then Exit For
                    If Trim(m_sPages(UBound(m_sPages))) <> "" Then
                        SyncLock (m_sPages)
                            For iPagesDone = LBound(m_sPagesDone) To UBound(m_sPagesDone)
                                If LCase(m_sPagesDone(iPagesDone)) = LCase(m_sPages(UBound(m_sPages))) Then
                                    If UBound(m_sPages) > 0 Then
                                        ReDim Preserve m_sPages(UBound(m_sPages) - 1)
                                    Else
                                        ReDim m_sPages(0)
                                    End If
                                    GoTo Err_Check_Exit
                                End If
                            Next iPagesDone

                            bOKToExit = False
                            For iThreadIndex = LBound(m_oThread) To UBound(m_oThread)
                                If IsNothing(m_oThread(iThreadIndex)) Then
                                    sTmpPage = m_sPages(UBound(m_sPages))
                                    If Trim(m_sPagesDone(UBound(m_sPagesDone))) <> "" Then _
                                             ReDim Preserve m_sPagesDone(UBound(m_sPagesDone) + 1)
                                    m_sPagesDone(UBound(m_sPagesDone)) = sTmpPage
                                    If UBound(m_sPages) > 0 Then
                                        ReDim Preserve m_sPages(UBound(m_sPages) - 1)
                                    Else
                                        ReDim m_sPages(0)
                                    End If
                                    StartThreading(sTmpPage, iThreadIndex, False, sSiteName)
                                End If
                            Next iThreadIndex
                        End SyncLock
                    End If
                    If m_bCancelClicked Then Exit For
                    Application.DoEvents()
                    If Not bOKToExit Then GoTo Err_Check_Exit
                End If
            Next i

        Catch ex As Exception
            MsgBox(ex.Message)
            Debug.WriteLine("bProcessSpider: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
            WriteErrorLog("bProcessSpider: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
        End Try
    End Sub

    Sub StartThreading(ByVal sURL As String, _
                    ByVal iThreadIndex As Integer, _
                    ByVal bFirstPassForSite As Boolean, _
                    ByVal sSiteName As String)

        Dim sURLProtocol, sURLBase, sURLPath, sURLPageName As String

        sURLProtocol = ""
        sURLBase = ""
        sURLPath = ""
        sURLPageName = ""

        Dim i As Integer

        Try
            'lblProcessed.Text = "Processed: " & FormatNumber(UBound(m_sPagesDone), 0, TriState.True, TriState.True, TriState.True)
            'lblRemaining.Text = "Remaining: " & FormatNumber(UBound(m_sPages), 0, TriState.True, TriState.True, TriState.True)
            'lblProcessed.Refresh()
            'lblRemaining.Refresh()
            BreakdownURL(sURL, sURLProtocol, sURLBase, sURLPageName, sURLPath)

            Dim oSpider As New clsSpider(sURLProtocol & sURLBase & sURLPath & sURLPageName, _
                                            sURLProtocol, _
                                            sURLBase, _
                                            sURLPath, _
                                            sURLPageName, _
                                            m_sFileTypes, _
                                            sSiteName, _
                                            iThreadIndex, _
                                            CBool(GetSetting(g_sAppName, "options", "ParseEntries", False)), _
                                            CBool(GetSetting(g_sAppName, "options", "ObeyRobots", False)))


            AddHandler oSpider.evFinished, AddressOf ehFinished
            AddHandler oSpider.evSendThreadID, AddressOf ehGetThreadID

            m_oThreadPage(iThreadIndex) = ""
            m_oThreadID(iThreadIndex) = 0
            If Not IsNothing(m_oThread(iThreadIndex)) Then
                MsgBox("Thread is not nothing...", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "Error...")
            Else
                m_oThreadPage(iThreadIndex) = sURLProtocol & sURLBase & sURLPath & sURLPageName
                m_oThread(iThreadIndex) = New Thread(AddressOf oSpider.ProcessURL)
                m_oThread(iThreadIndex).Start()
            End If

            oSpider = Nothing

        Catch
            Debug.WriteLine("StartThreading: " & ": " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
            Debug.WriteLine("StartThreading: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
            WriteErrorLog("StartThreading: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)

            Try
                For i = LBound(m_oThread) To UBound(m_oThread)
                    If Not IsNothing(m_oThread(i)) Then m_oThread(i).Abort()
                Next i
            Catch ex As Exception

                MsgBox(ex.Message)
                Debug.WriteLine("StartThreading: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
                WriteErrorLog("StartThreading: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)

            End Try
        End Try
    End Sub

    Private Sub ProcessRobots(ByVal sSiteName As String, ByVal sSiteURL As String)

        Dim sURLProtocol, sURLBase, sURLPath, sURLPageName, sPageResponded As String

        sURLProtocol = ""
        sURLBase = ""
        sURLPath = ""
        sURLPageName = ""
        sPageResponded = ""

        Dim iBytesRead As Long = 0

        Try
            BreakdownURL(sSiteURL, sURLProtocol, sURLBase, sURLPageName, sURLPath)

            Debug.WriteLine(sURLProtocol & sURLBase & "/robots.txt")

            Dim myReq As HttpWebRequest
            myReq = HttpWebRequest.Create(sURLProtocol & sURLBase & "/robots.txt")


            Dim myResponse As HttpWebResponse = myReq.GetResponse

            sPageResponded = myResponse.ResponseUri.ToString()

            Dim iContentLength As Integer
            Dim sTotalBuffer() As Byte
            If myResponse.ContentLength >= 0 Then
                iContentLength = myResponse.ContentLength

                Dim br As New BinaryReader(myResponse.GetResponseStream())
                Dim iTotalBytes As Integer = 0

                ReDim sTotalBuffer(iContentLength - 1)
                Dim sBuffer() As Byte
                iBytesRead = 1
                iTotalBytes = 0
                Do Until iBytesRead = 0
                    ReDim sBuffer(iContentLength - 1)
                    iBytesRead = br.Read(sBuffer, 0, iContentLength)
                    ReDim Preserve sBuffer(iBytesRead - 1)
                    If iBytesRead > 0 Then Array.Copy(sBuffer, 0, sTotalBuffer, iTotalBytes, sBuffer.Length)
                    iTotalBytes += iBytesRead
                Loop
            Else
                iContentLength = 1024

                Dim br As New BinaryReader(myResponse.GetResponseStream())
                Dim iTotalBytes As Integer = 0

                ReDim sTotalBuffer(0)
                Dim sBuffer() As Byte
                iBytesRead = 1
                iTotalBytes = 0
                Do Until iBytesRead = 0
                    ReDim sBuffer(iContentLength - 1)
                    iBytesRead = br.Read(sBuffer, 0, iContentLength)
                    ReDim Preserve sBuffer(iBytesRead - 1)
                    ReDim Preserve sTotalBuffer((UBound(sTotalBuffer) + 1) + iBytesRead - 1)
                    If iBytesRead > 0 Then Array.Copy(sBuffer, 0, sTotalBuffer, iTotalBytes, sBuffer.Length)
                    iTotalBytes += iBytesRead
                Loop

            End If

            Dim sTmpHTML As String = System.Text.Encoding.ASCII.GetString(sTotalBuffer)

            If Len(sTmpHTML) = 0 Then Exit Sub
            If InStr(1, sTmpHTML, "user-agent:", CompareMethod.Text) = 0 Then Exit Sub

            Dim sRobotsTxt() As String = Split(sTmpHTML, vbCrLf, -1, CompareMethod.Text)
            Dim i As Integer
            Dim sDisallow As String
            Dim bParsing As Boolean = False
            Dim iCommentPos As Integer
            For i = LBound(sRobotsTxt) To UBound(sRobotsTxt)
                Select Case True
                    Case Mid(sRobotsTxt(i), 1, 1) = "#"
                    Case Trim(sRobotsTxt(i)) = ""
                        bParsing = False
                    Case InStr(1, sRobotsTxt(i), "user-agent:", CompareMethod.Text) <> 0 And _
                        InStr(1, sRobotsTxt(i), "*", CompareMethod.Text) <> 0
                        bParsing = True
                    Case InStr(1, sRobotsTxt(i), "user-agent:", CompareMethod.Text) <> 0 And _
                        InStr(1, sRobotsTxt(i), "msdnspider", CompareMethod.Text) <> 0
                        bParsing = True
                    Case Else
                        If bParsing Then
                            sDisallow = Trim(Replace(sRobotsTxt(i), "disallow:", "", 1, -1, CompareMethod.Text))
                            sDisallow = Replace(sDisallow, vbTab, "", 1, -1, CompareMethod.Text)
                            iCommentPos = InStr(1, sDisallow, "#", CompareMethod.Text)
                            If iCommentPos <> 0 Then sDisallow = Trim(Mid(sDisallow, 1, iCommentPos - 1))
                            If Trim(m_sPagesDone(UBound(m_sPagesDone))) <> "" Then ReDim Preserve m_sPagesDone(UBound(m_sPagesDone) + 1)
                            m_sPagesDone(UBound(m_sPagesDone)) = sURLProtocol & sURLBase & sDisallow
                        End If
                End Select
            Next i
        Catch When Err.Number = 5
            Debug.WriteLine("ProcessRobots: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
        Catch
            Debug.WriteLine("ProcessRobots: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
            WriteErrorLog("ProcessRobots: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
        End Try

    End Sub

    Private Sub BreakdownURL(ByVal sURL As String, _
                                ByRef sURLProtocol As String, _
                                ByRef sURLBase As String, _
                                ByRef sURLPageName As String, _
                                ByRef sURLPath As String)

        Try
            Dim i As Integer = 0

            If InStr(1, sURL, "://", CompareMethod.Text) > 0 Then
                sURLProtocol = Mid(sURL, 1, InStr(1, sURL, "://", CompareMethod.Text) + Len("://") - 1)
            Else
                sURLProtocol = "http://"
            End If

            sURLBase = Replace(sURL, sURLProtocol, "", 1, -1, CompareMethod.Text)
            sURLBase = Mid(sURLBase, 1, InStr(1, sURLBase, "/", CompareMethod.Text) - 1)

            sURLPageName = ""
            For i = Len(sURL) To 1 Step -1
                Select Case Mid(sURL, i, 1)
                    Case "/"
                        sURLPageName = "/" & sURLPageName
                        Exit For
                    Case Else
                        sURLPageName = Mid(sURL, i, 1) & sURLPageName
                End Select
            Next i
            If (Len(sURL) - Len(sURLProtocol) - Len(sURLBase) - Len(sURLPageName)) >= 0 Then
                sURLPath = Mid(sURL, _
                                Len(sURLProtocol) + Len(sURLBase) + 1, _
                                Len(sURL) - Len(sURLProtocol) - Len(sURLBase) - Len(sURLPageName))
            Else
                sURLPath = ""
            End If

        Catch
            Debug.WriteLine("BreakdownURL: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
            WriteErrorLog("BreakdownURL: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
        End Try

    End Sub

    Public Sub ehFinished(ByVal aryPages() As String, _
                            ByVal iThreadIndex As Integer, _
                            ByVal sCompletedPage As String, _
                            ByVal sURLProtocol As String, _
                            ByVal sURLBase As String, _
                            ByVal sPageResponded As String)
        Dim i As Long
        Dim iStartPos As Integer = 0, iEndPos As Integer = 0, sExtension As String = ""


        Try
            SyncLock (m_sPages)
                sCompletedPage = Replace(sCompletedPage, sURLProtocol, "", 1, -1, CompareMethod.Text)
                sCompletedPage = Replace(sCompletedPage, sURLBase, "", 1, -1, CompareMethod.Text)
                If Trim(m_sPagesDone(UBound(m_sPagesDone))) <> "" Then ReDim Preserve m_sPagesDone(UBound(m_sPagesDone) + 1)
                m_sPagesDone(UBound(m_sPagesDone)) = sURLProtocol & sURLBase & sCompletedPage
                If Trim(Replace(sCompletedPage, "/", "", 1, -1, CompareMethod.Text)) = "" Then
                    If Trim(m_sPagesDone(UBound(m_sPagesDone))) <> "" Then ReDim Preserve m_sPagesDone(UBound(m_sPagesDone) + 1)
                    m_sPagesDone(UBound(m_sPagesDone)) = sPageResponded
                End If

                For i = LBound(aryPages) To UBound(aryPages)
                    If LCase(aryPages(i)) <> LCase(sCompletedPage) And _
                      LCase(aryPages(i)) <> LCase(sPageResponded) And _
                      Trim(LCase(aryPages(i))) <> "" And _
                      Array.IndexOf(m_sPages, aryPages(i)) = -1 And _
                      Array.IndexOf(m_sPagesDone, aryPages(i)) = -1 Then

                        iStartPos = InStr(1, aryPages(i), "?", CompareMethod.Text) - 1
                        If iStartPos > 0 Then
                            sExtension = Mid(aryPages(i), 1, iStartPos)
                        Else
                            sExtension = aryPages(i)
                        End If

                        iStartPos = sExtension.LastIndexOf(".")
                        sExtension = Mid(sExtension, iStartPos + 2, Len(sExtension))

                        Dim conn As New SqlConnection(strConn)
                        Dim mySQL As String = "InsertFileType"
                        Dim cmd As New SqlCommand(mySQL, conn)
                        cmd.CommandType = CommandType.StoredProcedure
                        cmd.Parameters.Add(New SqlParameter("@sFileType", sExtension))
                        conn.Open()
                        Dim lRecsAffected As Long = cmd.ExecuteNonQuery()
                        conn.Close()

                        If InStr(1, aryPages(i), sURLProtocol & sURLBase, CompareMethod.Text) <> 0 Then
                            If Trim(m_sPages(UBound(m_sPages))) <> "" Then ReDim Preserve m_sPages(UBound(m_sPages) + 1)
                            m_sPages(UBound(m_sPages)) = aryPages(i)

                            'With listStatus
                            '.BeginUpdate()
                            '.Items.Add("Got " & aryPages(i) & " from " & sPageResponded)
                            '.EndUpdate()
                            '.TopIndex = .Items.Count - 1
                            'End With
                            'listStatus.BeginUpdate()
                            'listStatus.Items.Add("Got " & aryPages(i) & " from " & sPageResponded)
                            'listStatus.EndUpdate()
                            'listStatus.TopIndex = listStatus.Items.Count - 1

                        End If
                    End If
                Next i
            End SyncLock

        Catch ex As Exception

            Debug.WriteLine("ehFinished: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
            WriteErrorLog("ehFinished: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)

        Finally

        End Try

    End Sub

    Public Sub ehGetThreadID(ByVal iThreadID As Long, ByVal iThreadIndex As Long)
        m_oThreadID(iThreadIndex) = iThreadID
    End Sub

    Private Sub GetFileTypes()
        'Get a listing of the file types from the registry
        'Update the listing in the box

        Try
            listProgress.Items.Clear()
            listProgress.BeginUpdate()
            listProgress.Items.Add("Getting File Types from the System Registry")
            listProgress.EndUpdate()
            listProgress.Refresh()

            'Redim the arrays
            ReDim m_sFileExtensions(0)
            ReDim m_sFileTypes(0)

            'Dim out some other variables
            Dim sTmp() As String = Registry.ClassesRoot.GetSubKeyNames
            Dim sSubKeys() As String
            Dim i As Integer, iSub As Integer
            Dim oKey As RegistryKey

            'Get a listing of keys from the registry with the file types
            For i = LBound(sTmp) To UBound(sTmp)
                If Mid(sTmp(i), 1, 1) = "." Then
                    'Now find out which of these has a content type
                    oKey = Registry.ClassesRoot.OpenSubKey(sTmp(i))
                    sSubKeys = oKey.GetValueNames
                    For iSub = LBound(sSubKeys) To UBound(sSubKeys)
                        If LCase(sSubKeys(iSub)) = LCase("Content Type") Then
                            If (m_sFileExtensions(UBound(m_sFileExtensions))).Trim <> "" Then ReDim Preserve m_sFileExtensions(UBound(m_sFileExtensions) + 1)
                            m_sFileExtensions(UBound(m_sFileExtensions)) = sTmp(i)
                            If (m_sFileTypes(UBound(m_sFileTypes))).Trim <> "" Then ReDim Preserve m_sFileTypes(UBound(m_sFileTypes) + 1)
                            m_sFileTypes(UBound(m_sFileTypes)) = oKey.GetValue(sSubKeys(iSub))
                        End If
                    Next iSub
                End If
            Next i

        Catch ex As Exception

            MsgBox(ex.Message)
            Debug.WriteLine("Getting file types: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
            WriteErrorLog("Getting file types: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)

        Finally

        End Try

    End Sub

    Private Sub GetRegistrySettings()
        If (GetSetting(g_sAppName, "init", "ThreadCount", "")).Trim = "" Then
            SaveSetting(g_sAppName, "init", "ThreadCount", "1")
        End If
        'txtThreadCount.Text = GetSetting(g_sAppName, "init", "ThreadCount", "5")
    End Sub

    Private Sub timerMain_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timerMain.Tick
        Dim i As Integer
        Dim sItems() As String

        Try
            ReDim sItems((m_oThread.GetLength(0) * 2) - 1)

            listProgress.Items.Clear()

            For i = LBound(sItems) To UBound(sItems) Step 2
                Select Case True
                    Case IsNothing(m_oThread(i / 2))
                        sItems(i) = "Thread " & ((i / 2) + 1) & ": Nothing"
                        sItems(i + 1) = " "
                    Case Not m_oThread(i / 2).IsAlive
                        sItems(i) = "Thread " & ((i / 2) + 1) & ": Not Alive: "
                        sItems(i + 1) = "   " & m_oThread(i / 2).ThreadState.ToString & _
                            "(" & m_oThread(i / 2).ThreadState & ")"
                    Case Else
                        sItems(i) = "Thread " & ((i / 2) + 1) & ": Active: Thread ID: " & _
                            m_oThreadID(i / 2)
                        sItems(i + 1) = "   Page Name: " & m_oThreadPage(i / 2) & ": " & _
                            m_oThread(i / 2).ThreadState.ToString & "(" & m_oThread(i / 2).ThreadState & ")"
                End Select
            Next i

            listProgress.Items.AddRange(sItems)

            lblTimeElapsed.Text = "Time Elapsed: " & _
                        Format(DateDiff("s", CDate(m_sNow), Now()) \ 3600, "00") & ":" & _
                        Format((DateDiff("s", CDate(m_sNow), Now()) \ 60) Mod 60, "00") & ":" & _
                        Format(DateDiff("s", CDate(m_sNow), Now()) Mod 60, "00")
            lblTimeElapsed.Refresh()

        Catch
            Debug.WriteLine("timerMain_Tick: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)
            WriteErrorLog("timerMain_Tick: " & Err.Number & ": " & Err.Description & "  " & Err.Erl)

        End Try
    End Sub

    '<end reference: http://msdn.microsoft.com/en-sg/magazine/cc188929(en-us).aspx#S1 >

    Private Sub frmMain_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed
        Application.Exit()
    End Sub

    Private Sub btnCredit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCredit.Click
        Me.Hide()
        iCredits.Show()
    End Sub
End Class